C**** LOOP2.F4 *********
C*** LOOP, SORT2, CODN, NALF, BAUTO, FINDIT, MVBEAM, MVBX
C*** JUGGLE, LTLLUP, XNOTE, UPDATE, NEWR, MSSLUP, RNX, LUP2
C*** RJED, RJED2, EDX, EQUAL, BOXX
C*** PARCH, RCURVE

	SUBROUTINE LOOP(I,J,K,L,M,N)
	DIMENSION N(1)
	MM=M-L
	II=I+L
	JJ=J+L
	DO 1 NN=I+L,J+L,K
1	N(NN)=N(NN+MM)
CLOOP:	0		;	DO 1 NN=I+L,J+L,K
C	MOVE	1,@4(16)
C	SUB 	1,@3(16) 	; MM IS IN 1
C	MOVE	2,@(16)
C	ADD	2,@3(16)	;I+L  -- NN, 1ST TIME
C	MOVE	3,@1(16)
C	ADD	3,@3(16)	;J+L
C	HRRZI	5,@5(16)		; ADR. OF N
C	ADDI	2,-1(5)		; N(II)  START
C	ADDI	3,-1(5)		; N(JJ)  FINISH
C	MOVE	4,@2(16)	;K
C	JUMPL	4,LP3		; JUMP IF NEG. INCR.
C	HRRM	1,.+1		; ADD IN MM  TO (2) AT LP1+1
CLP1:	MOVE	6,(2)
C	MOVEM	6,(2)		;N(NN)=N(NN+MM)
C	CAIGE	2,(3)
C	AOJA	2,LP1
C	JRA	16,6(16)
CLP3:	HRRM	1,.+1		; ADD IN MM  TO (2) AT LP2+1
CLP2:	MOVE	6,(2)		;NEG. INCR.
C	MOVEM	6,(2)
C	CAILE	2,(3)
C	SOJA	2,LP2
C	JRA 	16,6(16)	;	END
	END

	SUBROUTINE SORT2(RPOS,M)
	DIMENSION RPOS(2,200)
	L=2
3	J=-1
	RX=RPOS(1,L-1)
	DO 2 K=L,M
	IF(RPOS(1,K).GE.RX)GO TO 2
	RX=RPOS(1,K)
	J=K
2	CONTINUE
	IF(J.LT.0)GO TO 4
	K=L-1
	N=0
1	N=N+1
	X=RPOS(N,K)
	RPOS(N,K)=RPOS(N,J)
	RPOS(N,J)=X
	IF(N.EQ.1)GO TO 1
C	CALL EXCH(RPOS(1,K),RPOS(1,J))
C	CALL EXCH(RPOS(2,K),RPOS(2,J))
4	L=L+1
	IF(L.LE.M)GO TO 3
	END

	FUNCTION CODN(K,N)
	COMMON /PTR/KWDS(1) /XRN/RN(1)
C GET CODE NUMBER AND RETURN POINTER
	N=KWDS(K)
	CODN=RN(N+1)
	END

	FUNCTION NALF(I)
C CHANGE ASCII TO INTEGER
	IF(I.GE.0)GO TO 20
	J='A'
	M=-1
	GO TO 10
20	J=' '
	M=16
10	NALF=(I-J)/536870912-M
	END

	SUBROUTINE BAUTO(J,L,K,N)
C  FOR AUTOMATIC BEAMS.
	COMMON /SC/JS,LS,MK,ISKP,XMINUS,NS,IEXP,LK,NNUM,JJ,JN,DBST
	1,NFLG,JXX,ISEMX,JG,VX(1)
	J=J+2
	VX(J-1)=L-N
C**** A LIMIT OF 25 BEAMS PER LINE. ??
	VX(J)=K-N
	END

	FUNCTION FINDIT(N)
	COMMON R2
	COMMON /XRN/RN(1) /PTR/KWDS(1) /LIMIT/LIMIT,ITEM,L,I,IX
	FINDIT=0
	L=KWDS(N)
	IF(RN(L+1).NE.1)GO TO 377
	IF(RN(L+2).EQ.R2)RETURN
C SENDS BACK A NUM IN L
377	FINDIT=-1
	END

C  THESE MOVE ENDS OF PARTIAL INNER BEAMS.
	SUBROUTINE MVBEAM(R,I,JY,L,W)
C  L AND JY ARE FOR MOVES TO DIFF. STAFF.
	DIMENSION R(1)
	R(L+I)=R(JY+I)+W
	END

	SUBROUTINE MVBX(I)
	COMMON R2,JA,CENTR,J2,RJQ(20),L,RDIS /KJY/K,JY/XRN/R(1)
	EQUIVALENCE (R4,RJQ(2)),(R8,RJQ(6))
	R(L+I)=R8+(R(JY+I)-R4)*RDIS
	END

	SUBROUTINE JUGGLE
	IMPLICIT INTEGER(A-Z)
	REAL RN
	COMMON /DL/X22,SAVER,NAME /XRN/RN(1) /PTR/PWDS(1)
	COMMON /LIMIT/LIMIT,ITEM,L,I,IX/DPY/ST(4000),MEDIT,IGO
	1 /DPTR/WDS(1)
	ITEM=ITEM-1
	JX=RN(MEDIT)+3
C WD CNT OF OLD ITEM
C  I-IX IS WD CNT OF NEW ITEM
	JY=IX
	Z=I-IX-JX
C    SPACE CHANGE
	JX22=X22+1
	IF(Z)2751,172,751
751   CALL LOOP(I-1,MEDIT+JX,-1,Z,0,RN)
	JY=IX+Z
	GO TO 172
2751  CALL LOOP(MEDIT+JX+Z,IX+Z-1,1,0,-Z,RN)
172	J=RN(JY)+2	
	CALL LOOP(0,J,1,MEDIT,JY,RN)
	I=IX+Z
1751	X=ITEM+1
	JX=WDS(JX22)-WDS(X22)
	J=WDS(X+1)-WDS(X)
	Y=J-JX
	JX=WDS(X)+Y+1
	IF(Y)2851,182,282
282	CALL LOOP(WDS(X+1)+2,WDS(X22),-1,Y,0,ST)
	GO TO 182
2851  CALL LOOP(WDS(JX22)+Y+1,WDS(X)+Y+1,1,0,-Y,ST)
	JX=WDS(X)+1
182	CALL LOOP(1,J,1,WDS(X22)+1,JX,ST)
	IF(Z.NE.0)CALL LTLLUP(PWDS,Z,JX22,X)
	IF(Y.NE.0)CALL LTLLUP(WDS,Y,JX22,X)
C UPDATE PWDS AND WDS
	ST(2)=WDS(X)
	X22=0
	END

	SUBROUTINE LTLLUP(J,K,L,M)
	DIMENSION J(1)
	DO 1 N=L,M
1	J(N)=J(N)+K
	END

	FUNCTION XNOTE(J)
	COMMON/XRN/RN(1) /SCM/V(78),ISCR,LCNT,RSTF
	1 /RINP/R(10,80),RPOS(2,50),RI(200) 
	1 /POSI/STFF(0/7),JJ2,IPOS /STF/RSTFAC(0/7),RSTJ2
	XNOTE=AMOD(R(4,J),100.)
	IF(XNOTE.GE.80)XNOTE=XNOTE-100
C  FOR NEG. MINIS, ETC.
	A=R(10,J)
	IF(A.EQ.0)RETURN
	L=RSTF
	B=RSTFAC(L)
	K=1
	IF(A.EQ.2.)K=-1
C THIS STAFF POS.
	XNOTE=XNOTE+(STFF(L)-STFF(L+K))/(-7.*B)
	END

C CALLED FROM SLURZ, NEWR
	SUBROUTINE UPDATE(I)
	COMMON /LIMIT/LIMIT,ITEM,LL,IS /XRN/RN(1)
	RN(IS)=I
	IS=IS+I+3
	END

C CALLED FROM SLURZ, SCMSS
	SUBROUTINE NEWR
	COMMON/PTR/PWDS(1)/LIMIT/LIMIT,ITEM,LL,IS,IX
	COMMON/XRN/RN(1) /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
	COMMON/SCX/JALPHA(30),JX,U,JZ,IRHY,J4,KA,KB,IZ
	1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
	1 ,IXX,ISEMI,IQT,VX(50),IAMP,KQ,KN,M,MODE,IBLA
	1 /RINP/R(10,80),RPOS(2,50),RI(200) 
	IF(MODE.NE.1)GO TO 1
	IK=IS
	JIT=ITEM
1	IS=IK
	ITEM=JIT+1
C  MODE 1=NOTE, 2=RHYTH, 3=ACCENTS, 4=BEAMS, 5=SLURS.
C SKIPS INVIS RESTS - ONLY NEEDED IN RHYTH.
C  JUMP FOR BEAM CONT.
	K=1
2	IEND=-1
	X=R(1,K)
	IF(X.EQ.1.)GO TO 11
	IF(X.NE.2.)GO TO 12
	IF(R(6,K).GE.0)GO TO 12
	IF(R(7,K).EQ.0)GO TO 32
C  DELETE IF INVIS. REST AND NO RHYTHMIC VALUE.)
	GO TO 12
11	IEND=0
12	RN(IS+3)=0
	RN(IS+2)=0
C  ↑↑↑↑ TO CLEAR ARRAY FOR SHORT ITEMS (CLEFS)
	LK=10
	IF(MODE.GT.3)LK=8
C ONLY LOOK AT 8 PARAMS AFTER MODE 3.
	DO 3 L=LK,1,-1
	A=R(L,K)
	IF(IEND.GE.0)GO TO 14
	IF(A.EQ.0)GO TO 3
	IEND=L
14	RN(IS+L)=A
3	CONTINUE
13	RN(IS+2)=STAFF
	IF(X.NE.1)GO TO 4
	IEND=11
	RN(IS+11)=R(2,K)
C GET P11 VALUE
4	IF(IEND.LT.3)IEND=3
	IF(X.NE.1.)GO TO 34
	IF(MODE.NE.3)GO TO 34
	X=IS+11
	R(9,K)=X
34	CALL UPDATE(IEND-2)
32	IF(K.GE.IZ)RETURN
	K=K+1
	GO TO 2
	END

	SUBROUTINE MSSLUP
	COMMON /KNT/KNT /RRJJ/RJJ2,RJJ(20)
	COMMON R2,JA,CENTR,J2,RJQ(20)
	KNT=1
	DO 5543 K=1,10
	RA=RJQ(K)
	IF(RA.NE.0)KNT=K
5543	RJJ(K)=RA
	END
C ******* WILL SAVE UP TO PARAM 12 ONLY!

C*** CALLED FROM SLURZ
	SUBROUTINE RNX(A,B,C,D,E,F,G,H,RI)
	COMMON /XRN/RN(1) /LIMIT/LIMIT,ITEM,LL,I
	RN(I)=A
	RN(I+1)=B
	RN(I+2)=C
	RN(I+3)=D
	RN(I+4)=E
	RN(I+5)=F
	RN(I+6)=G
	RN(I+7)=H
	RN(I+8)=RI
	END

C*** CALLED FROM MAIN.
	SUBROUTINE LUP2
	COMMON R2,JA,CENTR,J2,RJQ(20)/LIMIT/LIM,ITEM,LL,I
	1 /KNT/KNT /XRN/RN(1)
	RN(I)=KNT
	RN(I+1)=JA
	I=I+2
	RN(I)=R2
	DO 4554 K=1,KNT
4554	RN(I+K)=RJQ(K)
	I=I+KNT+1
	END

C*** CALLED FROM RJED AND MAIN.
	SUBROUTINE PARCH(JA,JJA,RD)
	COMMON /RRJJ/RRJJ
	IF(JA.EQ.2)GO TO 1
	IF(JA.NE.1)RETURN
	IF(RD.EQ.0)RETURN
	IF(RD.LE.18.)JJA=RD
	RETURN
1	IF(RD.LE.7.)RRJJ=RD
	END

C*** CALLED FROM SLURZ AND MAIN.
	FUNCTION RCURVE(R)
	DIMENSION R(1)
C R(1) IS R3 WHEN CALL IS FROM MAIN.
	A=R(6)+1.
	B=R(4)-R(1)
	IF(A.GE.0)GO TO 1
	B=B+A+A
1	B=B/25.
	RCURVE=ABS(R(3)-R(2))/10.+B+.9
	IF(R(5).LT.0)RCURVE=-RCURVE
	END

	SUBROUTINE RJED
	COMMON R2,JA,CENTR,JJ2,RJQ(20),JQ(20)
	1 /RRJJ/RJJ2,RJJ(20),JJA
	DO 1222 K=1,20,2
	L=JQ(K)
	IF(L.EQ.0)RETURN
C  '600 2'  WILL ADD 2 TO PARAM 6.  '3000 6' SETS P3=P6.
	RD=RJQ(K+1)
	M=L
	IF(L.LT.100)GO TO 223
	IF(L.LT.2000)GO TO 5223
	M=L/1000
	L=JQ(K+1)-2
	RD=RJJ(L)
	GO TO 2223
5223	M=L/100
	IF(M.EQ.2)GO TO 1223
	RD=RJJ(M-2)+RD
	GO TO 2223
1223	RD=RJJ2+RD
223	IF(M.LE.2)GO TO 3223
2223	RJJ(M-2)=RD
	GO TO 1222
3223	CALL PARCH(M,JJA,RD)
C NOW P1 CAN BE CHANGED IN EDIT MODE -- BE CAREFUL,,,,!!!!!!
1222	CONTINUE
CC **  LOOP SET TO 20(20 IN ARRAY!) ONLY 13 PARAMS POSSIBLE NOW.
	END

	SUBROUTINE RJED2
	COMMON R2,JA,CENTR,JJ2,RJQ(20),JQ(20)
	1 /RRJJ/RJJ2,RJJ(20),JJA /LIMIT/LIMIT,ITEM,LL,I
	DO 5514 K=1,11
	R2=RJJ(K)
	RJQ(K)=R2
5514	JQ(K)=R2
	R2=RJJ2
	JA=JJA
	ITEM=ITEM-1
	IF(ITEM.LT.0)ITEM=0
	END
 
	FUNCTION EDX(RLINE)
	COMMON R2,JA /LIMIT/LIM,ITEM,L,I,IX
	1 /JCHAR/IXX,ISEMI,IBLA,IG,JED,KED,REDIT,RITEM 
	1 /XRN/RN(1) /DL/JX22 /PTR/KWDS(1)
	EDX=0
244	JX=ITEM  
	IF(JED.GT.JX)GO TO 444
	AC5=RITEM
	JAC7=0
C FLAG FOR '33' FEATURE
	IF(AC5.EQ.33.)GO TO 2
	IF(AC5.NE.44.)GO TO 1
C IF CODE NUM 33 = NON-CLEF ITEMS IN CODE 3  
C USE 44 FOR NON-BARLINES IN CODE 4
2	JAC7=-1
	AC5=AC5/11.
C CHANGE 33,44 BACK TO 3,4
C UNDER CODE 3 EXCEPT P5=0,1,2,3,4,5 (REAL CLEFS)
1	DO 144 K=JED,JX
	L=KWDS(K)
	IF(KED.EQ.-2)GO TO 654
C  -2 LOOKS AT ALL ITEMS NEAR VERT. LINE, -1 ON SINGLE STAFF.
	IF(KED.EQ.2)GO TO 656
	IF(RN(L+2).NE.REDIT)GO TO 144
	IF(KED.LT.0)GO TO 654
	IF(AC5.EQ.0)GO TO 655
656	IF(AC5.NE.RN(L+1))GO TO 144
	IF(JAC7.EQ.0)GO TO 655
C  SKIP NEXT UNLESS '33,44' FLAG IS SET (JAC7=-1)
	IF(RN(L).LE.2.)GO TO 144
C (TREBLE CLEF)
	IF(AC5.EQ.4)GO TO 655
C JUMP IF WDCNT OF CODE 4 .GT.2
	IF(RN(L+5).LE.5)GO TO 144 
C (SOME REAL CLEF)
655	IF(JA.NE.55)GO TO 344
654	IF(ABS(RLINE-RN(L+3)).GE.5.0)GO TO 144
C FINDS THINGS UP TO 5 STEPS ON EITHER SIDE OF VERTICAL LINE.
	IF(AC5.EQ.0)GO TO 1114
C  IF 0, ANY CODE NUM. WILL DO
	IF(AC5.NE.RN(L+1))GO TO 144
C  IS IT THE RIGHT CODE NUM?
1114	IF(REDIT.GT.7.)GO TO 344
C  STAFF NUM .GT. 7?
	IF(REDIT.EQ.RN(L+2))GO TO 344
C  OR IS IT SPECIFICALLY THE RIGHT STAFF NUM?
144	CONTINUE
444	REDIT=999.
	R2=0
C SO IT WILL RETURN IF NOTHING IS FOUND WITH 'ED' OR 'ST'.
	RETURN
344	JX22=K
	JED=K+1
C  FOR NEXT TIME AROUND
	EDX=-1.
C AC0=-1=GO TO 429, =>0=GO TO 73
	END

	SUBROUTINE EQUAL(X)
	COMMON R2,JA /RRJJ/RJJ2,RJJ(20)
	IF(JA.LE.13)GO TO 324
	JA=JA/10
C ADD 1000 TO PARAM TO MAKE EQUAL TO ANOTHER PARAM
	N=R2-2
	RJJ(JA-2)=RJJ(N)
	RETURN
324	N=JA-2
	IF(X.LT.0)GO TO 224
	RJJ(N)=R2
	RETURN
224	RJJ(N)=RJJ(N)+R2
	END

	SUBROUTINE BOXX
C*** USED IN MAIN. -- WHILE EDITING.
	COMMON R2,JA /LIMIT/LIM,ITEM,L,I,IX
	1 /JCHAR/IXX,ISEMI,IBLA,IG,JED,KED,REDIT,RITEM 
	1 /XRN/RN(1) /DL/JX22 /PTR/KWDS(1) /DPY/ID(4000),MEDIT,IGO
	COMMON /RRJJ/RJJ2,RJJ(20),JJA /DPTR/JWDS(1)
	1 /YED/JYED,IBOX,RBOX

429	IX=I
	MEDIT=KWDS(JX22)
	JY=RN(MEDIT)+2
	CALL LOOP(0,JY,1,I,MEDIT,RN)
	JJA=RN(I+1)
	JYED=JY-2
	L=I+2
	DO 422 K=1,11
	IF(K.GT.JYED)GO TO 423
	RJJ(K)=RN(L+K)
	GO TO 422
423	RJJ(K)=0
422	CONTINUE
	RJJ2=RN(L)
	IF(IGO.GT.0)GO TO 4231
C  NO BOX WHEN IN GROUP EDIT ROUTINE
	RBOX=RJJ2
	IBOX=I
	CALL BOX(IBOX,RBOX)
4231	ITEM=ITEM+1
CC	MOVE DPTR-1(1)		;	ST2=WDS(ITEM)
	END